perm filename TEST.F4[M11,LCS]1 blob
sn#404807 filedate 1978-12-16 generic text, type T, neo UTF8
00100 DIMENSION INP(80)
00110 DATA IBLA/' '/,ISEMI/';'/
00400 888 FORMAT(80A1)
00500 889 FORMAT(1XA5)
00600 890 FORMAT(' TYPE'/)
00650 891 FORMAT(1X80A1)
00700 5 TYPE 890
00800 ACCEPT 888,INP
00810 DO 1 J=1,80
00820 1 IF(INP(J).EQ.IBLA.OR.INP(J).EQ.ISEMI)GO TO 2
00830 2 JJ=J
00835 J=J-1
00840 N=J
00850 IF(J.GT.5)N=4
00860 DO 3 M=80,1,-1
00870 3 IF(INP(M).NE.IBLA)GO TO 4
00880 GO TO 5
00900 4 CALL PACKER(NN,INP,N)
00910 C NN BRINGS BACK PACKED NAME, INP IS ARRAY, N IS WDCNT.
01000 TYPE 889,NN
01010 70 DO 7 I=1,M-JJ
01020 7 INP(I)=INP(I+JJ)
01030 DO 8 I=M-J,M
01040 8 INP(I)=IBLA
01050 M=M-JJ
01100 TYPE 891,(INP(K),K=1,M)
01200 END
01300
04000 SUBROUTINE PACKER(NN,JNM,N)
04100 DIMENSION JNM(1),KNM(5)
04200 DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
04300 DATA MM/"774000000000/,IBLA/' '/
04400
04410 DO 10 K=1,5
04420 IF(K.GT.N)GO TO 11
04430 KNM(K)=JNM(K)
04440 GO TO 10
04450 11 KNM(K)=IBLA
04460 10 CONTINUE
05000 C N=WDCNT OF INST NAME
05100 NN=0
05200 DO 12 K=5,1,-1
05300 NN=NN .OR. (KNM(K) .AND. MM)
05400 IF (K.EQ.1)RETURN
05500 17 IF (NN.GE.0)GO TO 13
05600 NN = (( NN .AND. LL)/KK) .OR. JJ
05700 GO TO 12
05800 13 NN = NN / KK
05900 12 CONTINUE
06100 END